Wizualizacje interaktywne - plotly

Plotly

#install.packages("plotly")

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(plotly)

## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout

library(gapminder)

funkcja ggplotly = transformacja ggplot w wykres interakwyny

w <- ggplot(mpg, aes(displ,
                     hwy)) + 
  geom_point()

ggplotly(w)

wykres <- 
  ggplot(gapminder, 
         aes(y = lifeExp, 
             x = gdpPercap)) +
  geom_point()

x <- ggplotly(wykres)
x

y <- ggplotly(wykres)

style(y, 
      text = gapminder$country)

wykres <- ggplot(gapminder, aes(y = lifeExp, 
                                x = gdpPercap,
                                color = continent,
                                text = paste('kraj: ', country,
                  '<br>kontynent:', continent,
                  "<br>rok:", year)),
                 alpha = 0.5)  +
  geom_point()

ggplotly(wykres, tooltip = "text")

Połączenie z tabelką crosstalk o DT

Jeśli nie mamy zainstalowanych poniższych bibliotek to instalujmy je najpierw funkcją install.packages.

library(crosstalk)
library(DT)

Krok 1 zmieniamy format funkcją plotly::highlight_key

m <- highlight_key(mpg) # format ramki musi być zmieniony funkcją highlight_key

Krok2. Tworzymy wykres w ggplot z użyciem zmienionego formatu ramki

p <- ggplot(m, aes(displ, 
                   hwy)) + 
  geom_point() # tworzymy wykres w ggplocie z tej nowej ramki

Krok 3.

gg <- highlight(ggplotly(p), "plotly_selected") # tworzymy wykres plotly wewnątrz funkcji highlight, "plotly_hover" jest argumentem ustalającym jak wybierane będą podświetlane punkty

Krok 4. tworzymy tabelę interaktywną funkcją datatable pakietu DT i łączymy ją z wykresem funkcją bscols pakietu crosstalk

crosstalk::bscols(gg, DT::datatable(m)) # datatable tworzy tabelę, crosstalk::bscols łączy wykres z tabelą

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

Tabela pod wykresem

library(plotly)
 
m <- highlight_key(mpg) #czyli format ramki musi być zmieniony
 
p <- ggplot(m, aes(displ, hwy)) + 
  geom_point() #mamy wykres w ggplocie z tej nowej ramki
 
gg <- highlight(ggplotly(p), "plotly_hover") #mamy highlight(ggploly(tego wykresu)) i jeszcze argument dotyczący ego jak wybierać kolumny

crosstalk::bscols(gg, DT::datatable(m), widths = 12) #i mamy zestawienie elementów

## Warning in crosstalk::bscols(gg, DT::datatable(m), widths = 12): Sum of bscol
## width units is greater than 12

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_hover'). You can change this default via the `highlight()` function.

plotly podstawy

plot_ly(diamonds, x = ~cut)

## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram

plot_ly(diamonds, x = ~cut, y = ~clarity)

## No trace type specified:
##   Based on info supplied, a 'histogram2d' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram2d

plot_ly(diamonds, x = ~cut, 
        color = ~clarity, 
        colors = "Accent")

## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram

library(dplyr) 
diamonds %>% 
  plot_ly(x = ~cut) %>% 
  add_histogram() %>% 
  group_by(cut) %>% 
  summarise(n = n()) %>% 
  add_text( text = ~scales::comma(n), y = ~n,
 textposition = "top middle",
 cliponaxis = FALSE
 )

ggplotly

p1 <- ggplot(diamonds, aes(x = log(price),
                           color = clarity)) +
  geom_freqpoly() 

ggplotly(p)

p2 <- ggplot(diamonds, aes(x = log(price), 
                           color = clarity)) + 
  geom_freqpoly(stat = "density") + 
  facet_wrap(~cut)

ggplotly(p)

Aranżowanie wielu wykresów

subplot(p1,p2)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Animacje

data(gapminder, 
     package = "gapminder") 

gg <- ggplot(gapminder, aes(gdpPercap, 
                            lifeExp,
                            color = continent)) +
  geom_point(aes(size = pop,
                 frame = year,
                 ids = country)) + 
  scale_x_log10() 

## Warning in geom_point(aes(size = pop, frame = year, ids = country)): Ignoring
## unknown aesthetics: frame and ids

ggplotly(gg)

Panteon

panteon <- read_csv('https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/podstawy/panteon_s.csv')

## Rows: 11341 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, countryName, countryCode3, continentName, gender, industry, d...
## dbl (6): LAT, LON, birthyear, L_star, HPI, AverageViews
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

#install.packages("gganimate")
#install.packages("gifski")
#install.packages("av")

library(gganimate)

p <- ggplot(airquality, aes(Day, Temp)) + 
  geom_line(size = 2, colour = 'steelblue') + 
  transition_states(Month, 4, 1) + 
  shadow_mark(size = 1, colour = 'grey')

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

ggplot(mtcars, aes(factor(cyl), mpg)) + 
  geom_boxplot() + 
  # Here comes the gganimate code
  transition_states(
    gear,
    transition_length = 2,
    state_length = 1
  ) +
  enter_fade() + 
  exit_shrink() +
  ease_aes('sine-in-out')

Z danymi gapminder

ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, colour = country)) +
  geom_point(alpha = 0.7, show.legend = FALSE) +
  scale_colour_manual(values = country_colors) +
  scale_size(range = c(2, 12)) +
  scale_x_log10() +
  facet_wrap(~continent) +
  # Here comes the gganimate specific bits
  labs(title = 'Year: {frame_time}', x = 'GDP per capita', y = 'life expectancy') +
  transition_time(year) +
  ease_aes('linear')

Inne animacje z danymi gapminder

base <- gapminder %>% 
  plot_ly(x = ~gdpPercap, 
          y = ~lifeExp, 
          size = ~pop, 
          text = ~country, 
          hoverinfo = "text") %>% 
  layout(xaxis = list(type = "log"))

meanLife <- with(gapminder, tapply(lifeExp, INDEX = continent, mean)) 

gapminder$continent <- factor( gapminder$continent, levels = names(sort(meanLife)) )

base %>% 
  add_markers(data = gapminder, frame = ~continent) %>% hide_legend() %>% 
  animation_opts(frame = 1000, transition = 0, redraw = FALSE)

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

base %>% add_markers(
 color = ~continent, showlegend = F,
 alpha = 0.2, alpha_stroke = 0.2
 ) %>%
 add_markers(color = ~continent, frame = ~year, ids = ~country) %>%
 animation_opts(1000, redraw = FALSE)

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

## Warning: `line.width` does not currently support multiple values.

Graphical queries

library(plotly) 

mtcars %>% 
  highlight_key(~cyl) %>% # highliht key jako zmienna filtrująca jak w SQL SELECT * FROM mtcars WHERE cyl IN $SELECTION_VALUE
  plot_ly(
    x = ~wt, 
          y = ~mpg, 
          text = ~cyl, 
          mode = "markers+text",
          textposition = "top", 
          hoverinfo = "x+y")

## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

# load the `txhousing` dataset 
data(txhousing, package = "ggplot2") 
# declare `city` as the SQL 'query by' column 
tx <- highlight_key(txhousing, ~city) 
# initiate a plotly object 
base <- plot_ly(tx, color = I("black")) %>% 
  group_by(city) # create a time series of median house price 

(time_series <- base %>% 
  group_by(city) %>% 
  add_lines(x = ~date, y = ~median))

highlight( time_series, 
           on = "plotly_click",
           selectize = TRUE,
           dynamic = TRUE,
           persistent = TRUE
 )

## Adding more colors to the selection color palette.

## We recommend setting `persistent` to `FALSE` (the default) because persistent selection mode can now be used by holding the shift key (while triggering the `on` event).

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.

Poniżej powinno pozwolić mi wybierać kolory ale nie działa tak ja powinno

dot_plot <- base %>% 
  summarise(miss = sum(is.na(median))) %>% 
  filter(miss > 0) %>% 
  add_markers( x = ~miss,
 y = ~forcats::fct_reorder(city, miss),
 hoverinfo = "x+y"
 ) %>% layout(
 xaxis = list(title = "Number of months missing"),
 yaxis = list(title = "")
 ) 

dot_plot

highlight(dot_plot, 
           on = "plotly_click",
           selectize = TRUE,
           dynamic = TRUE,
           persistent = TRUE)

## Adding more colors to the selection color palette.

## We recommend setting `persistent` to `FALSE` (the default) because persistent selection mode can now be used by holding the shift key (while triggering the `on` event).

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.

subplot(dot_plot, 
        time_series, 
        widths = c(.2, .8), 
        titleX = TRUE) %>% 
  layout(showlegend = FALSE) %>%
  highlight(on = "plotly_selected", #plotly_selected zmienia zachowanie
            dynamic = TRUE, 
            selectize = TRUE,
            persistent = TRUE)

## Adding more colors to the selection color palette.

## We recommend setting `persistent` to `FALSE` (the default) because persistent selection mode can now be used by holding the shift key (while triggering the `on` event).

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

hist <- add_histogram(base, 
                      x = ~median, 
                      histnorm = "probability density" ) 

subplot(time_series, hist, nrows = 2) %>% 
  layout(barmode = "overlay", showlegend = FALSE) %>% 
  highlight( dynamic = TRUE,
 selectize = TRUE,
 selected = attrs_selected(opacity = 0.3)
 )

## Adding more colors to the selection color palette.

## Warning: Ignoring 616 observations

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.

highlight versus filter

library(crosstalk) 
# generally speaking, use a "unique" key for filter, # especially when you have multiple filters! 

tx <- highlight_key(txhousing)

gg <- ggplot(tx) + 
  geom_line(aes(date, median, group = city))

filter <- bscols(
 filter_select("id", "Select a city", tx, ~city),
 ggplotly(gg, dynamicTicks = TRUE),
 widths = c(12, 12)
 ) 

## Warning in bscols(filter_select("id", "Select a city", tx, ~city),
## ggplotly(gg, : Sum of bscol width units is greater than 12

tx2 <- highlight_key(txhousing, ~city, "Select a city") 

gg <- ggplot(tx2) + 
  geom_line(aes(date, median, group = city)) 

select <- highlight( ggplotly(gg, tooltip = "city"), 
                     selectize = TRUE, persistent = TRUE ) 

## We recommend setting `persistent` to `FALSE` (the default) because persistent selection mode can now be used by holding the shift key (while triggering the `on` event).

bscols(filter, select)

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.

Select a city

Checkbox

library(crosstalk) 

tx <- highlight_key(txhousing) 

widgets <- bscols( widths = c(12, 12, 12), 
                   filter_select("city", "Cities", tx, ~city),
                   filter_slider("sales", "Sales", tx, ~sales),
                   filter_checkbox("year", "Years", tx, ~year,
                                   inline = TRUE)
)

## Warning in bscols(widths = c(12, 12, 12), filter_select("city", "Cities", : Sum
## of bscol width units is greater than 12

bscols(widths = c(4, 8), 
        widgets, 
        plot_ly(tx, x = ~date, y = ~median, showlegend = FALSE) %>% 
          add_lines(color = ~city, colors = "black") 
        )

Cities

Sales

Years

2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015

Leaflet

library(leaflet) 

eqs <- highlight_key(quakes) 


stations <- filter_slider("station", "Number of Stations",
 eqs, ~stations
)

p    <- plot_ly(eqs, x = ~depth, y = ~mag) %>% 
  add_markers(alpha = 0.5) %>% 
  highlight("plotly_selected")

map <- leaflet(eqs) %>%
  addTiles() %>% 
  addCircles() 

## Assuming "long" and "lat" are longitude and latitude, respectively

bscols( widths = c(6, 6, 3), p, map, stations )

## Warning in bscols(widths = c(6, 6, 3), p, map, stations): Sum of bscol width
## units is greater than 12

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

Number of Stations

filter i highlight

library(gapminder) 

g <- highlight_key(gapminder, ~country) 

country_filter <- filter_select( "filter", "Select a country", g, ~country ) 

p    <- plot_ly(g) %>% 
  group_by(country) %>% 
  add_lines(x = ~year, 
            y = ~lifeExp, 
            color = ~continent) %>% layout(xaxis = list(title = "")) %>% 
  highlight(selected = attrs_selected(showlegend = FALSE))

bscols(country_filter, p, widths = 12)

## Warning in bscols(country_filter, p, widths = 12): Sum of bscol width units is
## greater than 12

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_click'). You can change this default via the `highlight()` function.

Select a country

Łączenie animowanych views

g <- highlight_key(gapminder, ~continent) 

gg <- ggplot(g, aes(gdpPercap, lifeExp, color = continent, frame = year)) +
  geom_point(aes(size = pop, ids = country)) +
 #geom_smooth(se = FALSE, method = "lm") +
 scale_x_log10()

## Warning in geom_point(aes(size = pop, ids = country)): Ignoring unknown
## aesthetics: ids

 highlight(ggplotly(gg), "plotly_hover")

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_hover'). You can change this default via the `highlight()` function.

g <- highlight_key(gapminder, ~continent) 

gg <- ggplot(g, aes(gdpPercap, lifeExp, color = continent, frame = year)) +
  geom_point(aes(size = pop, ids = country)) +
 geom_smooth(se = FALSE, method = "lm") +
 scale_x_log10()

## Warning in geom_point(aes(size = pop, ids = country)): Ignoring unknown
## aesthetics: ids

 highlight(ggplotly(gg), "plotly_hover")

## `geom_smooth()` using formula = 'y ~ x'
## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_hover'). You can change this default via the `highlight()` function.

Wykresy 3d

z danymi mpg

plot_ly(mpg, 
        x = ~cty, 
        y = ~hwy, 
        z = ~cyl) %>%
  add_markers(color = ~cyl)

z danymi panteon

kobiety <-  panteon %>%
  filter(gender == "Female",
         countryCode3 == "POL")

plot_ly(kobiety,
       x = ~AverageViews,
       y = ~HPI,
       z = ~L_star ) %>%
  add_trace()

## No trace type specified:
##   Based on info supplied, a 'scatter3d' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter3d

## No scatter3d mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

plot_ly(kobiety,
       x = ~AverageViews,
       y = ~HPI,
       z = ~L_star ) %>%
  add_trace()

## No trace type specified:
##   Based on info supplied, a 'scatter3d' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter3d

## No scatter3d mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

library(deSolve)

# Initial state 
parms <- c(a=10, b=8/3, c=26.48)
state <- c(x=0.01, y=0.0, z=0.0)

# Time span
times <- seq(0, 100, by=1/500)

# Lorenz system
lorenz <- function(times, state, parms) {
  with(as.list(c(state, parms)), {
    dxdt <- a*(y-x)
    dydt <- x*(c-z)-y
    dzdt <- x*y-b*z
    return(list(c(dxdt, dydt, dzdt)))
  })
}

# Make dataframe
df <- as.data.frame(ode(func=lorenz, y=state, parms=parms, times=times))

df <- read_csv("https://raw.githubusercontent.com/Tomasz-Olczyk/wizualizacjaR/main/wykresy%20interaktywne/lorenz.csv")

## Rows: 50001 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (4): time, x, y, z
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

x <- seq_len(nrow(volcano)) + 100
y <- seq_len(ncol(volcano)) + 500

plot_ly() %>% 
  add_surface(x = ~x,
              y = ~y, 
              z = ~volcano)

plot_ly(df,
        x= ~x,
        y= ~y,
        z = ~z,
        marker = list(size = 0.8))

## No trace type specified:
##   Based on info supplied, a 'scatter3d' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter3d

## No scatter3d mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

Inne przykłady

library(dplyr)
 cities <- c("Galveston", "Midland", "Odessa", "South Padre Island")
 
txsmall <- txhousing %>%
 select(city, year, month, median) %>%
 filter(city %in% cities)
 txsmall %>% highlight_key(~year) %>% { 
   ggplot(., aes(month, median, group = year)) + geom_line() + facet_wrap(~city, ncol = 2)
 } %>%
ggplotly(tooltip = "year")

demo("crosstalk-highlight-binned-target-a", package = "plotly")

## 
## 
##  demo(crosstalk-highlight-binned-target-a)
##  ---- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
## 
## > # These examples demonstrate ways to display binned/aggregated selections
## > library(plotly)
## 
## > d <- highlight_key(mpg)
## 
## > dots <- plot_ly(d, colors = "Set1", color = ~class, x = ~displ, y = ~jitter(cyl)) %>%
## +   layout(
## +     xaxis = list(title = "Engine displacement"),
## +     yaxis = list(title = "Number of cylinders")
## +   )
## 
## > boxs <- plot_ly(d, colors = "Set1", color = ~class, x = ~class, y = ~cty) %>% 
## +   add_boxplot() %>%
## +   layout(
## +     xaxis = list(title = ""),
## +     yaxis = list(title = "Miles per gallon (city)")
## +   )
## 
## > bars <- plot_ly(d, colors = "Set1", x = ~class, color = ~class)
## 
## > subplot(dots, boxs, titleX = TRUE, titleY = TRUE) %>%
## +   subplot(bars, nrows = 2, titleX = TRUE, titleY = TRUE) %>%
## +   layout(
## +     title = "Dynamic 2-way ANOVA (click & drag on scatterplot)",
## +     barmode = "overlay",
## +     showlegend = FALSE
## +   ) %>%
## +   highlight("plotly_selected", opacityDim = 0.6)

## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

## No scatter mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

d <- highlight_key(mpg)

dots <- plot_ly(d, colors = "Set1", color = ~class, x = ~displ, y = ~jitter(cyl)) %>%
 layout(
xaxis = list(title = "Engine displacement"),
yaxis = list(title = "Number of cylinders")
)

 boxs <- plot_ly(d, colors = "Set1", color = ~class, x = ~class, y = ~cty) %>% 
  add_boxplot() %>%
layout(
 xaxis = list(title = ""),
  yaxis = list(title = "Miles per gallon (city)")
 )

bars <- plot_ly(d, colors = "Set1", x = ~class, color = ~class)

subplot(dots, boxs, titleX = TRUE, titleY = TRUE) %>%
  subplot(bars, nrows = 2, titleX = TRUE, titleY = TRUE) %>%
layout(
  title = "Dynamic 2-way ANOVA (click & drag on scatterplot)",
   barmode = "overlay",
  showlegend = FALSE
) %>%
highlight("plotly_selected", opacityDim = 0.6)

## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter

## No scatter mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

queries z ggplotem

m <- highlight_key(mpg, ~class)

p1 <- ggplot(m, aes(displ, fill = class)) + geom_density()

p2 <- ggplot(m, aes(displ, hwy, fill = class)) + geom_point()

subplot(p1, p2) %>% 
  hide_legend() %>%
  highlight("plotly_hover")

## Setting the `off` event (i.e., 'plotly_doubleclick') to match the `on` event (i.e., 'plotly_hover'). You can change this default via the `highlight()` function.

leaflet

library(leaflet) 

qquery <- highlight_key(quakes) 
p    <- plot_ly(qquery, x = ~depth, y = ~mag) %>% 
  add_markers(alpha = 0.5) %>% 
  highlight("plotly_selected", dynamic = TRUE) 

## Adding more colors to the selection color palette.

map <- leaflet(qquery) %>% 
  addTiles() %>% 
  addCircles()

## Assuming "long" and "lat" are longitude and latitude, respectively

# persistent selection can be specified via options() 

withr::with_options( list(persistent = TRUE), crosstalk::bscols(widths = c(6, 6), p, map)
)

## Setting the `off` event (i.e., 'plotly_deselect') to match the `on` event (i.e., 'plotly_selected'). You can change this default via the `highlight()` function.

trelliscope

#install.packages("trelliscop")

library(trelliscopejs)

data(gapminder, package = "gapminder")

qplot(year, lifeExp, data = gapminder) +
 xlim(1948, 2011) + ylim(10, 95) + 
  theme_bw() + 
  facet_trelliscope(~ country + continent, nrow = 2, ncol = 6, width = 300, as_plotly = TRUE, plotly_args = list(dynamicTicks = T), plotly_cfg = list(displayModeBar = F) 
)